home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / yourt.arc / YA2LOOK.BAS (.txt) < prev   
Encoding:
GW-BASIC  |  1979-12-31  |  3.6 KB  |  141 lines
  1. 10  GOTO 60
  2. 20  ' YA2LOOK.BAS        YOURART2 PICTURE DISPLAY PROGRAM
  3. 30  ' JULY 1984          EVERETT DELANO
  4. 40  '                    P.O. BOX 205
  5. 50  '                    ELK CITY, OKLA. 73648
  6. 60  SCREEN 0,1,0,0:WIDTH 80:KEY OFF
  7. 70  GOSUB 1230
  8. 80  DEFINT A-Z:DIM SORT$(101)
  9. 90  DEF SEG=0:IF (PEEK(&H410) AND &H30) <> &H30 THEN 100 ELSE 1100
  10. 100  DEF SEG:POKE 106,0
  11. 110  ON ERROR GOTO 1010
  12. 120  FOR COUNT=1 TO 10:KEY COUNT,"":NEXT
  13. 130  COLOR 7,4,1:CLS
  14. 140  LEGEND$="* Press   Esc   To EXIT *"
  15. 150  LOCATE 25,28:COLOR 2:PRINT LEGEND$;:COLOR 7
  16. 160  TITLE$="* * * * YOURART  HIGH  RESOLUTION  DISPLAY * * * *"
  17. 170  CENTER=(80-LEN(TITLE$))/2
  18. 180  LOCATE 1,CENTER,0:PRINT TITLE$
  19. 190  LOCATE 2,22:COLOR 19:PRINT "(MAXIMUM OF 88 PICTURES PER SESSION)":COLOR 7
  20. 200  LOCATE 5,8,0
  21. 210  PRINT"WHICH DRIVE CONTAINS THE PICTURES: ";
  22. 220  INK$=INKEY$:IF LEN(INK$)<>1 THEN  220
  23. 230  IF INK$=CHR$(27) THEN 1070
  24. 240  PRINT INK$;
  25. 250  IF ASC(INK$)>96 AND ASC(INK$)<103 THEN INK$=CHR$(ASC(INK$)-32)
  26. 260  IF INSTR("ABCDEF",INK$)<1 THEN LOCATE 6,1,0:GOSUB 960:GOTO 200
  27. 270  DRIVE$=LEFT$(INK$,1)+":"
  28. 280  LOCATE 7,8,0
  29. 290  PRINT "MANUAL OR AUTOMATIC DISPLAY"
  30. 300  LOCATE 8,27,0:PRINT "SELECT M or A : ";
  31. 310  INK$=INKEY$:IF INK$="" THEN 310
  32. 320  IF INK$=CHR$(27) THEN 1070
  33. 330  PRINT INK$;
  34. 340  S=INSTR("MmAa",INK$):IF S<1 THEN LOCATE 9,1,0:GOSUB 960:GOTO 300
  35. 350  IF S=1 OR S=2 THEN GOTO 790
  36. 360  LOCATE 25,26:BEEP:COLOR 18:PRINT "* Enter    QUIT    To EXIT *";:COLOR 7
  37. 370  LOCATE 10,8,0
  38. 380  PRINT "DISPLAY DURATION IN SECONDS"
  39. 390  LOCATE 11,1,0:PRINT STRING$(79," ");:LOCATE 11,29,0
  40. 400  INPUT "MAXIMUM  60 : ",SECS$
  41. 410  IF SECS$="QUIT" OR SECS$="quit" OR SECS$="Quit" THEN 1070
  42. 420  SECS=VAL(SECS$)
  43. 430  IF SECS>60 THEN LOCATE 11,1,0:GOSUB 960:GOTO 390
  44. 440  LOCATE 5,8,0
  45. 450  IF S=1 OR S=2 THEN GOTO 790
  46. 460  WIDTH 80:COLOR 0,0,0:CLS
  47. 470  FILES DRIVE$+"*.PIC"
  48. 480  GOSUB 1130
  49. 490  CROW=CSRLIN
  50. 500  COUNT=0
  51. 510  LOCATE 1,1,1
  52. 520  FOR ROW=STL TO CROW
  53. 530  FOR COL=1 TO 72 STEP STP
  54. 540  COUNT=COUNT+1
  55. 550  FOR N=0 TO 11
  56. 560  SORT$(COUNT)=SORT$(COUNT)+CHR$(SCREEN(ROW,(COL+N)))
  57. 570  NEXT N
  58. 580  IF LEFT$(SORT$(COUNT),1)=" " THEN COUNT=COUNT-1 :GOTO 620
  59. 590  SORT$(COUNT)=DRIVE$+SORT$(COUNT)
  60. 600  NEXT COL
  61. 610  NEXT ROW
  62. 620  IF COUNT > 88 THEN 1080
  63. 630  TOTPICS=COUNT
  64. 640  FOR COUNT=1 TO TOTPICS-1
  65. 650  FOR PLACE=COUNT+1 TO TOTPICS
  66. 660  IF SORT$(PLACE)<SORT$(COUNT) THEN SWAP SORT$(COUNT),SORT$(PLACE)
  67. 670  NEXT PLACE
  68. 680  NEXT COUNT
  69. 690  SCREEN 2
  70. 700  FOR PIC=1 TO TOTPICS
  71. 710  BLOAD SORT$(PIC)
  72. 720  GOSUB 760
  73. 730  CLS
  74. 740  NEXT PIC
  75. 750  GOTO 1070
  76. 760  IF VMODE$="M" THEN GOTO 890
  77. 770  FOR CLOCK!=1 TO 1100*SECS:NEXT
  78. 780  RETURN
  79. 790  CLS:LOCATE 5,22,0:PRINT "Grey Plus Key `+' for next picture."
  80. 800  LOCATE 7,22,0:PRINT "Grey Minus Key `-' for previous picture."
  81. 810  LOCATE 9,22,0:PRINT "Esc  Key to EXIT from display"
  82. 820  LOCATE 11,22,0:PRINT "Press   ";CHR$(17);CHR$(196);CHR$(217);"   to begin"
  83. 830  LOCATE 25,26,0:COLOR 18:PRINT "* Press   Esc   To Exit *";:COLOR 7
  84. 840  INK$=INKEY$:IF INK$="" THEN 840
  85. 850  IF INK$=CHR$(27) THEN 1070
  86. 860  IF INK$<>CHR$(13) THEN 840
  87. 870  VMODE$="M"
  88. 880  GOTO 460
  89. 890  INK$=INKEY$:IF INK$="" THEN 890
  90. 900  IF INK$="+" THEN RETURN
  91. 910  IF INK$="-" THEN PIC=PIC-2:GOSUB 940:RETURN
  92. 920  IF INK$=CHR$(27) THEN 1070
  93. 930  GOTO 890
  94. 940  IF PIC=-1 THEN PIC=0
  95. 950  RETURN
  96. 960  BEEP:LOCATE CSRLIN,20,0:PRINT "IMPROPER RESPONSE - PLEASE TRY AGAIN!!";
  97. 970  FOR COUNT=1 TO 5000:NEXT
  98. 980  LOCATE CSRLIN,1,0:PRINT STRING$(79," ");
  99. 990  LOCATE CSRLIN-1,1,0:PRINT STRING$(79," ");
  100. 1000  BEEP:RETURN
  101. 1010  IF ERL<>470 THEN 1040
  102. 1020  COLOR 14,1,0:CLS:LOCATE 12,10,1:PRINT "NO PICTURE FILES FOUND"
  103. 1030  GOSUB 1340:END
  104. 1040  SCREEN 0,1,0,0:WIDTH 80:COLOR 14,1,0:CLS
  105. 1050  LOCATE 12,10,11:PRINT "ERROR";ERR;" OCCURED IN LINE";ERL
  106. 1060  GOSUB 1340:END
  107. 1070  SCREEN 0,1,0,0:WIDTH 80:COLOR 14,1,0:CLS:GOSUB 1340:END
  108. 1080  COLOR 14,1,0:CLS:LOCATE 12,10,1:PRINT "TOO MANY PICTURE FILES!!"
  109. 1090  GOSUB 1340:END
  110. 1100  DEF SEG:POKE 106,0:COLOR 14,1,0:CLS:BEEP
  111. 1110  LOCATE 12,15:PRINT "IBM COMPATABLE COLOR GRAPHICS CARD REQUIRED!"
  112. 1120  BEEP:END
  113. 1130  IF SCREEN(1,14)=32 THEN 1160
  114. 1140  STP=13
  115. 1150  GOTO 1200
  116. 1160  IF SCREEN(1,14)=32 THEN 1190
  117. 1170  STP=13
  118. 1180  GOTO 1200
  119. 1190  STP=18
  120. 1200  IF SCREEN(1,9)=46 THEN STL=1:GOTO 1220
  121. 1210  STL=2
  122. 1220  RETURN
  123. 1230  DEF SEG:P=0
  124. 1240  FOR COUNT=1 TO 10
  125. 1250  KEYHOLD$(COUNT)=""
  126. 1260  WHILE PEEK(P+1619)<>0
  127. 1270  KEYHOLD$(COUNT)=KEYHOLD$(COUNT)+CHR$(PEEK(P+1619))
  128. 1280  P=P+1
  129. 1290  WEND
  130. 1300  P=COUNT*16
  131. 1310  KEYHOLD$(COUNT)=KEYHOLD$(COUNT)+CHR$(0)
  132. 1320  NEXT
  133. 1330  RETURN
  134. 1340  DEF SEG
  135. 1350  FOR COUNT=1 TO 10
  136. 1360  FOR PLACE=1 TO LEN(KEYHOLD$(COUNT))
  137. 1370  POKE 1618+(COUNT-1)*16+PLACE,ASC(MID$(KEYHOLD$(COUNT),PLACE))
  138. 1380  NEXT PLACE,COUNT
  139. 1390  KEY OFF:KEY ON
  140. 1400  RETURN
  141.